perm filename INSANE.LAP[206,JMC] blob
sn#070511 filedate 1973-11-02 generic text, type T, neo UTF8
(LAP CYCLES SUBR)
(PUSH P 1)
(PUSH P 1)
(PUSH P (C 0 0 (QUOTE NIL) 0))
(PUSH P (C 0 0 (QUOTE NIL) 0))
(PUSH P (C 0 0 (QUOTE NIL) 0))
TAG1 (MOVE 1 -4 P)
(JUMPE 1 TAG6)
(PUSH P -4 P)
(MOVE 2 0 P)
(MOVE 1 -4 P)
(CALL 2 (E UPTO) S)
(MOVE 2 1)
(POP P 1)
(CALL 2 (E *APPEND) S)
(CALL 1 (E NCONS) S)
(MOVEM 1 -2 P)
(MOVE 1 -1 P)
(JUMPE 1 TAG12)
(MOVE 1 -2 P)
(HRRM@ 1 -1 P)
(HRRZ@ 2 -1 P)
(JRST 0 TAG11)
TAG12 (MOVE 2 -2 P)
(MOVEM 2 0 P)
TAG11 (HRRZ@ 1 -4 P)
(MOVEM 1 -4 P)
(MOVEM 2 -1 P)
(JRST 0 TAG1)
TAG6 (MOVE 1 0 P)
(SUB P (C 5 0 5 0))
(POPJ P)
NIL
(LAP UPTO SUBR)
(PUSH P 1)
(PUSH P 2)
(CAME 2 1)
(JRST 0 TAG2)
(MOVEI 1 (QUOTE NIL))
(JRST 0 TAG1)
TAG2 (HLRZ@ 1 -1 P)
(MOVE 2 0 P)
(PUSH P 1)
(HRRZ@ 1 -2 P)
(CALL 2 (E UPTO) S)
(POP P 2)
(CALL 2 (E XCONS) S)
TAG1 (SUB P (C 2 0 2 0))
(POPJ P)
NIL
(LAP PRUP SUBR)
(PUSH P 1)
(PUSH P 2)
(JUMPE 1 TAG1)
(HLRZ@ 2 0 P)
(HLRZ@ 1 -1 P)
(CALL 2 (E CONS) S)
(HRRZ@ 2 0 P)
(PUSH P 1)
(HRRZ@ 1 -2 P)
(CALL 2 (E PRUP) S)
(POP P 2)
(CALL 2 (E XCONS) S)
TAG1 (SUB P (C 2 0 2 0))
(POPJ P)
NIL
(LAP SUBFUN1LOSE SUBR)
(HRRZ@ 2 1)
(HLRZ@ 1 1)
(JCALL 2 (E MEMBER) S)
NIL
(LAP LOSE SUBR)
(MOVE 2 1)
(MOVEI 1 (QUOTE SUBFUN1LOSE) S)
(JCALL 2 (E ORLIS) S)
NIL
(LAP TER SUBR)
(HLRZ@ 1 1)
(CALL 1 (E LENGTH) S)
(MOVEI 2 (QUOTE 4))
(JCALL 2 (E EQUAL) S)
NIL
(LAP SUBFUN1SUCCESSORS SUBR)
(JCALL 2 (E XCONS) S)
NIL
(LAP SUCCESSORS SUBR)
(PUSH P 1)
(HLRZ@ 1 1)
(CALL 1 (E LENGTH) S)
(PUSH P (SPECIAL PUZZ) S)
(CALL 1 (E ADD1) S)
(MOVE 2 1)
(POP P 1)
(CALL 2 (E NTH) S)
(HLRZ@ 2 1)
(PUSH P 2)
(PUSH P (C 0 0 (QUOTE NIL) 0))
(PUSH P (C 0 0 (QUOTE NIL) 0))
(PUSH P (C 0 0 (QUOTE NIL) 0))
TAG1 (MOVE 1 -3 P)
(JUMPE 1 TAG6)
(HLRZ@ 1 -3 P)
(MOVE 3 1)
(MOVE 2 -4 P)
(MOVEI 1 (QUOTE SUBFUN1SUCCESSORS) S)
(CALL 3 (E MAPCAR2) S)
(CALL 1 (E NCONS) S)
(MOVEM 1 -2 P)
(MOVE 1 -1 P)
(JUMPE 1 TAG12)
(MOVE 1 -2 P)
(HRRM@ 1 -1 P)
(HRRZ@ 2 -1 P)
(JRST 0 TAG11)
TAG12 (MOVE 2 -2 P)
(MOVEM 2 0 P)
TAG11 (HRRZ@ 1 -3 P)
(MOVEM 1 -3 P)
(MOVEM 2 -1 P)
(JRST 0 TAG1)
TAG6 (MOVE 1 0 P)
(SUB P (C 5 0 5 0))
(POPJ P)
NIL
(SETQ PUZZ3 (APPEND (CYCLES (QUOTE (2 3 4 5))) (CYCLES (QUOTE (2 5 4 3))) (CYCLES (QUOTE (1 2 6 4))) (CYCLES (QU→
OTE (1 4 6 2))) (CYCLES (QUOTE (1 3 6 5))) (CYCLES (QUOTE (1 5 6 3)))))
(SETQ PUZZ1 (QUOTE ((G B B W R G) (G G B G W R) (G W W R B R) (G G R B W W))))
(SETQ PUZZ2 (MAPCAR (FUNCTION (LAMBDA (X) (PRUP (QUOTE (1 2 3 4 5 6)) X))) PUZZ1))
(SETQ PUZZ4 (MAPCAR (FUNCTION (LAMBDA (S) (SUBLIS S PUZZ3))) PUZZ2))
(SETQ PUZZ (CONS (LIST (CAR (NTH (CAR PUZZ4) 1)) (CAR (NTH (CAR PUZZ4) 11)) (CAR (NTH (CAR PUZZ4) 21))) (CDR PUZ→
Z4)))
(SETQ P0 (QUOTE (NIL NIL NIL NIL)))